home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pct3661.arc / PCCMWF.MRG < prev    next >
Text File  |  1986-04-25  |  5KB  |  142 lines
  1. 316 BGI=BG:FGI=FG:IFLAG=0:BFLAG=0:ESC=0:C$=""
  2. 330 FOR I=1 TO 7:READ A$:LOCATE ,39:PRINT VL$;A$;SPACE$(38-LEN(A$));VL$:NEXT
  3. 365 DATA"          Color/Music/Windows
  4. 636 IF IB THEN 13030
  5. 637 X = LEN(A$):P=INSTR(A$,LF$):IF P=0 THEN 638 ELSE A$=LEFT$(A$,P-1)+RIGHT$(A$,X-P):GOTO 637
  6. 638 FOR I = 1 TO X:Z$=MID$(A$,I,1)
  7. 639 IF (Z$=CHR$(127)) THEN 655
  8. 640 IF ASC(Z$) = 27 THEN ESC=1
  9. 641 IF Z$=BS$ THEN GOSUB 2650:GOTO 655
  10. 645 IF ESC=1 THEN C$=C$+Z$ ELSE GOTO 650
  11. 646 FF = INSTR("fmJ"+CHR$(14)+CHR$(93)+CHR$(124)+CHR$(91),Z$)
  12. 647 IF FF=0 THEN GOTO 655 ELSE GOSUB 12000:ESC=0:C$="":GOTO 655
  13. 650 PRINT Z$;
  14. 655 NEXT I
  15. 1517 IF IB AND EX=72 THEN B$=CHR$(30):GOTO 535
  16. 1518 IF IB AND EX=71 THEN B$=CHR$(11):GOTO 535
  17. 1519 IF IB AND EX=80 THEN B$=CHR$(31):GOTO 535
  18. 1684 IF EX=24 THEN 13000
  19. 2100 DATA" Alt-L  Chg Def Drv  Alt-M  Messages
  20. 2105 DATA" Alt-O  IBM 3101     Alt-P  Com Parms
  21. 11999 '
  22. 12000 '   ***** IBM 3101 EMULATION PLUS COLORS, MUSIC & WINDOWS FOR RBBS *****
  23. 12001 '
  24. 12002 '  -- Escape Control
  25. 12010 CLEN=LEN(C$)
  26. 12020 CEND$=MID$(C$,CLEN,1)
  27. 12025 IF CLEN<>2 THEN 12030
  28. 12027 IF ASC(CEND$)<>91 THEN RETURN 'INVALID ESC SEQ
  29. 12030 ON FF GOTO 12300,12070,12070,12400,12500,12600,12700
  30. 12050 RETURN
  31. 12059 '
  32. 12060 '  -- Color Control
  33. 12070 FOR J=1 TO INT(CLEN/3):Z = VAL(MID$(C$,(3*J),2))
  34. 12080 IF Z = 30 THEN FG = 0: GOTO 12290 'BLACK
  35. 12090 IF Z = 31 THEN FG = 4: GOTO 12290 'RED
  36. 12100 IF Z = 32 THEN FG = 2: GOTO 12290 'GREEN
  37. 12110 IF Z = 33 THEN FG = 6: GOTO 12290 'BROWN 
  38. 12120 IF Z = 34 THEN FG = 1: GOTO 12290 'BLUE
  39. 12130 IF Z = 35 THEN FG = 5: GOTO 12290 'MAGENTA
  40. 12140 IF Z = 36 THEN FG = 3: GOTO 12290 'CYAN
  41. 12150 IF Z = 37 THEN FG = 7: GOTO 12290 'WHITE
  42. 12160 IF Z = 40 THEN BG = 0: GOTO 12290 'BLACK
  43. 12170 IF Z = 41 THEN BG = 4: GOTO 12290 'RED
  44. 12180 IF Z = 42 THEN BG = 2: GOTO 12290 'GREEN
  45. 12190 IF Z = 43 THEN BG = 6: GOTO 12290 'BROWN 
  46. 12200 IF Z = 44 THEN BG = 1: GOTO 12290 'BLUE
  47. 12210 IF Z = 45 THEN BG = 5: GOTO 12290 'MAGENTA
  48. 12220 IF Z = 46 THEN BG = 3: GOTO 12290 'CYAN
  49. 12230 IF Z = 47 THEN BG = 7: GOTO 12290 'WHITE
  50. 12240 IF Z = 0  THEN BG = BGI: FG = FGI:IFLAG = 0:BFLAG=0: GOTO 12290
  51. 12250 IF Z = 2  THEN CLS   : LOCATE 1,1:GOTO 12290 'CLEAR
  52. 12260 IF Z = 1  THEN IFLAG = 8:GOTO 12290 'INTENSITY HIGH
  53. 12270 IF Z = 5  THEN BFLAG = 16:GOTO 12290 'BLINK
  54. 12280 '
  55. 12290 NEXT J:FFG=FG+IFLAG+BFLAG:COLOR FFG,BG:RETURN
  56. 12299 '
  57. 12300 '  -- Cursor Position
  58. 12320 PROW=VAL(MID$(C$,CLEN-5,2))
  59. 12330 PCOL=VAL(MID$(C$,CLEN-2,2))
  60. 12340 LOCATE PROW,PCOL
  61. 12350 RETURN
  62. 12399 '
  63. 12400 '  -- Music Control
  64. 12420 PLAY MID$(C$,3,(CLEN-3))
  65. 12430 RETURN
  66. 12499 '
  67. 12500 '  -- Screen Control
  68. 12520 MODE=VAL(MID$(C$,CLEN-11,2))
  69. 12530 BURST=VAL(MID$(C$,CLEN-8,2))
  70. 12540 APAGE=VAL(MID$(C$,CLEN-5,2))
  71. 12550 VPAGE=VAL(MID$(C$,CLEN-2,2))
  72. 12560 SCREEN MODE,BURST,APAGE,VPAGE
  73. 12570 RETURN
  74. 12599 '
  75. 12600 '  -- String Input
  76. 12620 INPUT I$:PRINT #1,I$
  77. 12630 RETURN
  78. 12699 '
  79. 12700 '  -- Escape Sequency Verify
  80. 12720 RETURN 655
  81. 13000 IF IB THEN IB=0:PRINT"===I.B.M. 3101 Operation Off":BEEP:GOTO 515
  82. 13015 IB=-1:BEEP:PRINT"===I.B.M. 3101 Operation On":GOTO 515
  83. 13030 FOR I = 1 TO LEN(A$):C$=MID$(A$,I,1)
  84. 13035 ON ESCSEQ GOTO 13145,13170,13180
  85. 13040 IF C$<" " THEN 13070
  86. 13045 PRINT C$;:COL=COL+1:IF COL>80 THEN COL=1:ROW=ROW+1:IF ROW>24 THEN ROW=24
  87. 13050 GOTO 13355
  88. 13055 '
  89. 13060 '  -- 3101 Control Character Encountered
  90. 13070 C=ASC(C$)
  91. 13075 IF C=13 THEN COL=1:GOTO 13350
  92. 13080 IF C=30 AND ROW>1 THEN ROW=ROW-1:GOTO 13350
  93. 13085 IF C=22 THEN C=10:C$=CHR$(C)
  94. 13090 IF C=10 AND ROW<24 THEN ROW=ROW+1:GOTO 13350
  95. 13095 IF C=10 THEN PRINT C$;:GOTO 13355
  96. 13100 IF C=8  AND COL>1 THEN COL=COL-1:GOTO 13350
  97. 13105 IF C=28 AND COL<80 THEN COL=COL+1:GOTO 13350
  98. 13110 IF C=30 THEN ROW=1:COL=1:GOTO 13350
  99. 13115 IF C=12 THEN ROW=1:COL=1:CLS:GOTO 13350
  100. 13120 IF C<>27 THEN 13355
  101. 13125 '
  102. 13130 '  -- ESC Sequence; Read Next Character & Come Back
  103. 13140 ESCSEQ=1:GOTO 13355
  104. 13145 ESCSEQ=0:IF C$<>"Y" THEN 13205
  105. 13150 '
  106. 13155 '  -- Repositioning Cursor; Now Get Row & Column Bytes
  107. 13165 ESCSEQ=2:GOTO 13355
  108. 13170 ROW=ASC(C$)-31:IF ROW<1 OR ROW>24 THEN ROW=1
  109. 13175 ESCSEQ=3:GOTO 13355
  110. 13180 COL=ASC(C$)-31:IF COL<1 OR COL>80 THEN COL=1
  111. 13185 ESCSEQ=0:GOTO 13350
  112. 13190 '
  113. 13195 ' -- Handle Cursor Up
  114. 13205 IF C$<>"A" THEN 13235
  115. 13210 IF ROW >1 THEN ROW=ROW-1
  116. 13215 GOTO 13350
  117. 13220 '
  118. 13225 ' Handle cursor down
  119. 13230 '
  120. 13235 IF C$<>"B" THEN 13270
  121. 13240 IF ROW <24 THEN ROW=ROW+1
  122. 13245 GOTO 13350
  123. 13250 '
  124. 13255 '  -- Handle Cursor Right
  125. 13270 IF C$<>"C" THEN 13300
  126. 13275 COL=COL+1:IF COL >80 THEN COL=1:IF ROW > 23 THEN ROW=24 ELSE ROW=ROW+1
  127. 13280 GOTO 13350
  128. 13285 '
  129. 13290 '  -- Handle Cursor Left
  130. 13300 IF C$<>"D" THEN 13330
  131. 13305 COL=COL-1:IF COL <1 THEN COL=80:IF ROW > 1 THEN ROW=ROW-1 ELSE ROW=1
  132. 13310 GOTO 13350
  133. 13315 '
  134. 13320 '  -- Handle Erase to End of Page
  135. 13330 IF C$<>"J" THEN 13355
  136. 13335 IF ROW<24 THEN PRINT SPACE$(81-COL);
  137. 13340 IF ROW<23 THEN FOR TROW=ROW+1 TO 23:PRINT SPACE$(80);:NEXT TROW
  138. 13345 IF ROW<24 THEN PRINT SPACE$(79); ELSE PRINT SPACE$(80-COL);
  139. 13350 LOCATE ROW,COL,1
  140. 13355 NEXT
  141. 13360 GOTO 515
  142.